VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "WebFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database

' -----------------------------------------------------
' | Class: WebFunctions
' | Purpose:  Used to perform common web functions such as checking if a system is online, retrieving a web site, parsing a JSON string, etc.
' | Author: Lenear
' | Revision: 1.0
' | Revision Date: 9-10-2011
' ----------------------------------------------------

Private Declare Function InetIsOffline Lib "url.dll" _
    (ByVal dwFlags As Long) As Long
    
'-------------------Properties-----------------

' A property that returns true if the system is connected to the internet, false if it is not.
Public Property Get IsConnected() As Boolean
    IsConnected = (Not InetIsOffline(0))
End Property

'-------------------Public Functions ------------------------------------

Public Function getWebsite(straddr As String) As String
' Returns the a website in the form of a string object

Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", straddr, False
objHttp.Send

Debug.Print objHttp.status
getWebsite = objHttp.ResponseText
    
End Function
Public Function JSON(strJSON As String)
Dim objResult As Object
Dim sc As Object

Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
sc.addcode "function toDictionary(o){var result = new ActiveXObject(""Scripting.Dictionary"");for (var key in o){if (typeof(o[key]) == 'object'){result.Add(key, toDictionary(o[key]));}else{result.Add(key, o[key]);} } return result;}"
Set objJSON = sc.Eval("(" + strJSON + ")")
Set JSON = sc.Run("toDictionary", objJSON)

End Function

Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    Dim StringLen As Long: StringLen = Len(StringVal)
    
    If StringLen > 0 Then ReDim result(StringLen) As String
        Dim i As Long, CharCode As Integer
        Dim Char As String, Space As String
    
        If SpaceAsPlus Then Space = "+" Else Space = "%20"
    
        For i = 1 To StringLen
        Char = Mid$(StringVal, i, 1)
            CharCode = Asc(Char)
            Select Case CharCode
                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                    result(i) = Char
                Case 32
                    result(i) = Space
                Case 0 To 15
                    result(i) = "%0" & Hex(CharCode)
                Case Else
                    result(i) = "%" & Hex(CharCode)
            End Select
        Next i
        URLEncode = Join(result, "")
End Function

'-----------------Private Functions -------------

    

